home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lib / shell.pl < prev    next >
Encoding:
Text File  |  1997-11-12  |  4.0 KB  |  219 lines
  1. /*  File:    shell.pl
  2.     Purpose: Limited Unix Shell Emulation
  3.     Author:  Jan Wielemaker
  4.     Date:    Sep 16 1989
  5. */
  6.  
  7. :- module(shell,
  8.     [ (ls)/0
  9.     , (ls)/1
  10.     , (cd)/0
  11.     , (cd)/1
  12.     , (pushd)/0
  13.     , (pushd)/1
  14.     , dirs/0
  15.     , pwd/0
  16.     , popd/0
  17.     , mv/2
  18.     , (rm)/1
  19.     ]).
  20.  
  21. % :- op(900, fy, [ls, cd, pushd, rm, grep]).
  22.  
  23. /*  Shell Emulation Library
  24.  
  25.     This library is meant for systems that do not allow us to get access
  26.     to the operating system via shell/[0,1,2].  It is developed  on  the
  27.     ST-MINIX version.  MINIX does not have a vfork() call, and thus only
  28.     allows  shell/[0,1,2]  if  Prolog  uses less than half the amount of
  29.     available memory.  This library offers a number  of  predicates  for
  30.     listing, directory management, deleting, copying and renaming files.
  31.  
  32.  ** Sun Sep 17 12:04:54 1989  jan@swi.psy.uva.nl */
  33.  
  34. %    cd
  35. %    cd(Dir)
  36. %    Change working directory
  37.  
  38. (cd) :-
  39.     cd(~).
  40.  
  41. cd(Dir) :-
  42.     name_to_atom(Dir, Name),
  43.     chdir(Name).
  44.  
  45. %    dirs    -- Print Directory Stack
  46. %    pushd    -- Push Directory Stack
  47. %    popd    -- Pop Directory Stack
  48.  
  49. :- dynamic
  50.     stack/1.
  51.  
  52. (pushd) :-
  53.     pushd(+1).
  54.  
  55. pushd(N) :-
  56.     integer(N), !,
  57.     findall(D, stack(D), Ds),
  58.     (   nth1(N, Ds, Go),
  59.         retract(stack(Go))
  60.     ->  pushd(Go)
  61.     ;   warning('Directory stack not that deep'),
  62.         fail
  63.     ).
  64. pushd(Dir) :-
  65.     name_to_atom(Dir, Name),
  66.     absolute_file_name('', Old),
  67.     chdir(Name),
  68.     asserta(stack(Old)).
  69.  
  70. popd :-
  71.     retract(stack(Dir)), !,
  72.     chdir(Dir).
  73. popd :-
  74.     warning('Directory stack empty'),
  75.     fail.
  76.  
  77. dirs :-
  78.     (   absolute_file_name('', D)
  79.     ;   stack(D)
  80.     ),
  81.     dir_name(D, Name),
  82.     format('~w ', [Name]),
  83.     fail.
  84. dirs :-
  85.     nl.
  86.  
  87. pwd :-
  88.     absolute_file_name('', D),
  89.     dir_name(D, Name),
  90.     format('~w~n', [Name]).
  91.  
  92. dir_name('/', '/') :- !.
  93. dir_name(Path, Name) :-
  94.     concat(P, /, Path), !,
  95.     dir_name(P, Name).
  96. dir_name(Path, Name) :-
  97.     feature(unix, true),
  98.     absolute_file_name('~', Home0),
  99.     (   concat(Home, /, Home0)
  100.     ->  true
  101.     ;   Home = Home0
  102.     ),
  103.     concat(Home, FromHome, Path), !,
  104.     sformat(Name, '~~~w', [FromHome]).
  105. dir_name(Path, Path).
  106.  
  107. %    ls
  108. %    ls(Dir|Files)
  109. %    List a directory, flag directories with a '/'
  110.  
  111. (ls) :-
  112.     ls('.').
  113.  
  114. ls(Spec) :-
  115.     name_to_atom(Spec, Atom),
  116.     expand_file_name(Atom, Matches),
  117.     ls_(Matches).
  118.  
  119. ls_([Dir]) :-
  120.     exists_directory(Dir), !,
  121.     absolute_file_name('', Here),
  122.     chdir(Dir),
  123.     expand_file_name('*', Files),
  124.     chdir(Here),
  125.     ls__(Files).
  126. ls_(Files) :-
  127.     ls__(Files).
  128.  
  129. ls__([]) :- !,
  130.     warning('No Match'),
  131.     fail.
  132. ls__(Files) :-
  133.     maplist(tag_file, Files, Tagged),
  134.     list_atoms(Tagged, 72).
  135.  
  136. tag_file(File, Dir) :-
  137.     exists_directory(File),    
  138.     concat(File, /, Dir).
  139. tag_file(File, File).
  140.  
  141. %    mv(+From, +To)    --- Move (Rename) a file
  142. %    rm(+File)    --- Remove (unlink) a file
  143.  
  144. mv(From, To) :-
  145.     name_to_atom(From, A0),
  146.     name_to_atom(To, A1),
  147.     rename_file(A0, A1).
  148.  
  149. rm(File) :-
  150.     name_to_atom(File, A),
  151.     delete_file(A).
  152.  
  153. %    name_to_atom(Typed, Atom)
  154. %    Convert a typed name into an atom
  155.  
  156. name_to_atom(Atom, Atom) :-
  157.     atomic(Atom), !.
  158. name_to_atom(Term, Atom) :-
  159.     term_to_atom(Term, Raw),
  160.     name(Raw, S0),
  161.     sublist(non_blank, S0, S1),
  162.     name(Atom, S1).
  163.  
  164. non_blank(C) :-
  165.     between(0, 32, C), !,
  166.     fail.
  167. non_blank(_).
  168.  
  169.  
  170. %    list_atoms(+List, +Width)
  171. %    List a set of atoms multicolumn on a Width wide output device.
  172.  
  173. list_atoms(List, W) :-
  174.     length(List, L),
  175.     Term =.. [l|List],
  176.     longest(List, Longest),
  177.     Columns is W // (Longest + 3),
  178.     Rows is integer(L / Columns + 0.49999),    % should be ceil/1
  179.     ColumnWidth is W // Columns,
  180.     Max is Columns * Rows - 1,
  181.     between(0, Max, N),
  182.         Index is N // Columns + (N mod Columns) * Rows + 1,
  183.         (    (N+1) mod Columns =:= 0
  184.         ->    NL = nl
  185.         ;    NL = fail
  186.         ),
  187.         (    arg(Index, Term, Atom),
  188.         atom_length(Atom, AL),
  189.         write(Atom),
  190.         (   NL == fail
  191.         ->  tab(ColumnWidth - AL)
  192.         ;   true
  193.         )
  194.         ->  true
  195.         ;   true
  196.         ),
  197.         NL,
  198.     fail.
  199. list_atoms(_, _).
  200.  
  201. longest(List, Longest) :-
  202.     longest(List, 0, Longest).
  203.  
  204. longest([], M, M) :- !.
  205. longest([H|T], Sofar, M) :-
  206.     atom_length(H, L),
  207.     L >= Sofar, !,
  208.     longest(T, L, M).
  209. longest([_|T], S, M) :-
  210.     longest(T, S, M).
  211.  
  212. %    warning(Fmt, [Args]).
  213.  
  214. warning(Fmt) :-
  215.     warning(Fmt, []).
  216.  
  217. warning(Fmt, Args) :-
  218.     '$break'('$warning'(Fmt, Args)).
  219.